perm filename TRANS1.LSP[206,JMC] blob
sn#188573 filedate 1975-11-25 generic text, type T, neo UTF8
(DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
(T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
(SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
(TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
(T (TRANSFORM W R DONE)))) (TRANSA E R)))))
(DE TRANSA (E R) (COND ((NULL R) E) (T
((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
(TRANSB E (CAR R))))))
(DE TRANSB (E RULE) ((LAMBDA (W) (COND ((EQ W (QUOTE NO)) E)
(T (SUBLIS (CADR RULE) W)))) (INST E (CAR RULE) NIL)))
(DE SIDE (X Y) X)
(SETQ R1 (QUOTE (
((PLUS X.Y) (PLUSA X (PLUS.Y)))
((PLUSA 0 . X) (PLUSA . X))
((PLUS.NIL) (PLUSB.NIL))
((PLUSA X (PLUSB.Y)) (PLUSB X.Y))
((PLUSA (PLUSB . X)) (PLUSB . X))
)))
(SETQ R2 (QUOTE (
((PLUS X . Y) (PLUSA X (PLUS .Y)))
((PLUS . NIL) 0)
((PLUSA 0 . X) (PLUSA . X))
((PLUSA) 0)
((PLUSA X 0) X)
((PLUSA X) X)
((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) .Z))
((TIMES X . Y) (TIMESA X (TIMES . Y)))
((TIMES) 1)
((TIMESA 1 . X) (TIMESA . X))
((TIMESA) 1)
((TIMESA X 1) X)
((TIMESA X) X)
((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA .Y) .Z))
((TIMES 0 . X) 0)
((TIMESA 0 . X) 0)
)))
(SETQ R3 (QUOTE (
((PLUS X.Y) (X /+ .(PLUS.Y)))
((/+ PLUS.NIL) NIL)
)))
(DE POOF (X Y) NIL)
(DE PRLIS (X) (COND ((NULL X) NIL)
((ATOM X) (POOF (PRINC X) NIL))
(T (POOF (PRINC (CAR X)) (PRLIS (CDR X))))))
(SETQ R4 (QUOTE (
((PLUSA X Y) (PLUS X Y))
((PLUSA X (PLUS.Y)) (PLUS X . Y))
)))